#!/usr/bin/env tclsh

# Copyright (c) 2009 Prabhu Gurumurthy  <pgurumur@gmail.com>
# 
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
# __version__  = "$Revision: f1837e1015c1 $"
# __author__   = "$Author: pgurumur $"
# __modified__ = "$Date: 2012-12-03 17:38:20Z $"

package require http 2
lappend ::auto_path venya
package require netaddr

proc addrtest address {
   catch {
      netaddr::ip $address
      set addr [netaddr::getaddress]
      set version [netaddr::getversion]
      set integer [netaddr::ip2integer]
      set size [netaddr::getsize]
      set isloop [netaddr::isloopback]
      set ismcast [netaddr::ismulticast]
      set islocal [netaddr::islinklocal]
      set reserve [netaddr::isreserved]
      set specd [netaddr::isunspecified]
      set network [netaddr::isnetwork]
      set scope [netaddr::ifscope]
      set complete [netaddr::completeip]

      puts "Address: $addr"
      puts "IP version: $version"
      puts "Integer value: $integer"
      puts "Size of the network: $size"
      puts "Complete IP: $complete"

      if {$version == 4} {
         set mask [netaddr::getmask]
         set wildcard [netaddr::getwildcard]

         puts "Netmask: $mask"
         puts "Wildcard: $wildcard"
      }

      if {$network} {
         puts "$addr is a network!"
      }

      if {$isloop} {
         puts "$addr is a loopback!"
      }

      if {$ismcast} {
         puts "$addr is a multicast!"
      }

      if {$islocal} {
         puts "$addr is link local!"
      }

      if {$reserve} {
         puts "$addr is reserved!"
      }

      if {$specd} {
         puts "$addr is unspecified!"
      }

      if {[string length $scope]} {
         puts "Scope interface: $scope"
      }

      puts "-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+\n"
   } result errorinfo

   set errargs [split $errorinfo " "]
   set code [lindex $errargs 1]
   if {$code != 0} {
     puts "$address: $errorinfo"
   }
}

proc filegrab url {
   set token [http::geturl $url -validate 1]
   upvar #0 $token head
   set ctype [dict get $head(meta) Content-Type]
   set filename ""
   if {$ctype == "text/plain"} {
      set filename [lindex [split $url /] end]
   }

   if {[string length $filename]} {
      if {[file exists $filename]} {
         puts "$filename already exists, not downloading!"
      } else {
         http::cleanup $token
         set hfile [open $filename {WRONLY CREAT EXCL}]
         set token [http::geturl $url -channel $hfile]
         http::cleanup $token
         close $hfile
      }

      http::cleanup $token

      if {[file exists $filename]} {
         set fh [open $filename r]
         while {[gets $fh line] >= 0} {
            if {[regexp {^#.*} $line]} {
               continue
            } elseif {[regexp {^$} $line]} {
               continue
            } else {
               set ipaddr $line
               puts "IP: $ipaddr"
               addrtest $ipaddr
            }
         }

         close $fh
      }
   }
}

proc printsubnet value {
   foreach network $value {
      puts $network
   }

   puts "-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+\n"
}

proc testwithin {address subnets} {
   netaddr::ip $address
   foreach ip $subnets {
      if {[netaddr::contains $ip]} {
         puts "$ip is WITHIN $address"
      } else {
         puts "$ip is NOT WITHIN $address"
      }
   }
}

if {[string length $argv]} {
   if {$argv == "file"} {
      filegrab "http://www.team-cymru.org/Services/Bogons/fullbogons-ipv4.txt"
      filegrab "http://www.team-cymru.org/Services/Bogons/fullbogons-ipv6.txt"
   } elseif {$argv == "manual"} { 
      puts "IPv6 unicast address testing!"
      addrtest "2001:2::/31"

      puts "IPv4 unicast address testing!"
      addrtest "24.51.224/19"

      puts "Complete IPv4 unicast address testing!"
      addrtest "23.80/12"

      puts "IPv6 loopback address testing!"
      addrtest "::1"

      puts "IPv4 loopback address testing!"
      addrtest "127.0.0.1"

      puts "IPv6 multicast address testing!"
      addrtest "ff00::5"

      puts "IPv4 multicast address testing!"
      addrtest "224.0.0.5"

      puts "IPv6 reserved address testing!"
      addrtest "FE00:abcd::/16"

      puts "IPv4 reserved address testing!"
      addrtest "240.123.136.0/24"

      puts "IPv6 link local address testing!"
      addrtest "fe80::215:c5ff:fe78:5fb6/64"

      puts "IPv4 link local address testing!"
      addrtest "169.254.192.0/22"

      puts "IPv6 unspecified address testing!"
      addrtest "::"

      puts "IPv4 unspecified address testing!"
      addrtest "0.200.199.0/24"

      puts "Scope IP address testing!"
      addrtest "fe80::21d:7dff:fe93:c5ed%nfe0"

      puts "IPv6 illegal address testing!"
      addrtest "fdc2:c2cd:d343:::abdc:/96"
      addrtest "fdgh::/8"

      puts "IPv4 illegal address testing!"
      addrtest "10.20.30.-1"
      addrtest "10.256.0/25"
   } elseif {$argv == "subnet"} {
      catch {
         netaddr::ip "5.35.193.0/21"
         printsubnet [netaddr::subnets 22] 
         printsubnet [netaddr::subnets 24] 
         printsubnet [netaddr::subnets 25] 
         printsubnet [netaddr::subnets 21] 
         printsubnet [netaddr::subnets 27] 
         printsubnet [netaddr::subnets 23] 

         netaddr::ip "2001:500::/48"
         printsubnet [netaddr::subnets 52]
         printsubnet [netaddr::subnets 49]
         printsubnet [netaddr::subnets 65]

         netaddr::ip "172.29.17.5"
         printsubnet [netaddr::subnets 32]
      } result errorinfo

      set errargs [split $errorinfo " "]
      set code [lindex $errargs 1]
      if {$code != 0} {
         puts $errorinfo
      }
   } elseif {$argv == "contains"} {
      set address "5.35.193.0/21"
      set within "5.35.192.1 5.35.193.1 5.35.199.255 5.35.200.0"
      testwithin $address $within

      set address "2001:500::/48"
      set within "2001:4ff::1 2001:0500:0000:ffff::/64"
      testwithin $address $within
   } elseif {$argv == "integer"} {
      netaddr::ip 1749820096 22 4
      puts [netaddr::getaddress]
      puts [netaddr::ntop [netaddr::getnetwork] 4]

      netaddr::ip 42540488320432167789079031612388147200 31 6
      puts [netaddr::getaddress]
      puts [netaddr::ntop [netaddr::getnetwork] 6]
   } elseif {$argv == "compress"} {
      set ipaddr "2001:0500:0000:ffff:0000:0000:0000:0000/64 \
         fe80:0000:0000:0000:0215:c5ff:fe78:5fb6/64 \
         0000:0000:0000:0000:0000:0000:0000:0000/3 \
         2001:0000:0000:ffde:abcd:edab:cdef:abcd/64 \
         2001:1868:0209:abdc:abdc:0000:0000:defc/64"

      foreach addr $ipaddr {
         set temp [split $addr /]
         set hextets [split [lindex $temp 0] :]
         if {[llength $temp] == 2} {
            set prefix [lindex $temp 1]
         } else {
            set prefix 128
         }

         puts $hextets
         puts [netaddr::_compress $hextets]
      }
   } elseif {$argv == "help"} {
      puts "options are: "
      puts " contains"
      puts " compress"
      puts " integer"
      puts " subnet"
      puts " file"
      puts " manual"
      puts " normal"
   } elseif {$argv == "normal"} {
      set address "::1 2001:10::"
      foreach ip $address {
         puts [netaddr::_normalize $ip 6]
      }
   }
}
